; ORIGINAL: 3dt2.1/examples/attrib.scm
; $Id: attrib.scm,v 1.3 1996/10/21 15:58:52 aed Exp $
;======================================================================
; Purpose---
;    Define procedures for selecting based on attributes
;
;======================================================================

;; Do selection of entities based on a given predicate
(define (select pred?)
  (let loop ((ents (part:entities))
             (found '()))
    (cond
     ((null? ents) found)
     ((pred? (car ents)) (loop (cdr ents) (cons (car ents) found)))
     (else (loop (cdr ents) found))
     )))

;;----------------------------------------------------------------------
;; Create a predicate which tests to see if an entity has an attribute
;; with a given name whose value meets the given (optional) test.
;;  name  = a string which is the attribute name
;;  test? = a predicate which will be applied to an attribute value
(define (has-attrib name . test?)
  (lambda (ent)
    (let loop ((attrib-list (attrib:get ent name)))
      (cond
       ((null? attrib-list) #f)
       ((null? test?) #t)
       (((car test?) (cdar attrib-list)) #t)
       (else (loop (cdr attrib-list)))
       ))))

;;----------------------------------------------------------------------

;; procedures for creating predicates for testing for numeric values
(define number= (lambda (n) (lambda (v) (and (number? v) (= v n)))))
(define number> (lambda (n) (lambda (v) (and (number? v) (> v n)))))
(define number< (lambda (n) (lambda (v) (and (number? v) (< v n)))))
(define number-in-range (lambda (lo hi)
                          (lambda (v) (and (number? v) (>= v lo) (<= v hi)))))


;; Create a predicate to test if a value is a given string
(define string-value (lambda (s)
		       (lambda (v) (and (string? v) (string-ci=? v s)))))

;;======================================================================
;; Examples of use.  These examples assume that entities may have an
;; attribute whose name is "level"

;; to select all entities on level 1
;; (select (has-attrib "level" (number= 1)))

;; to select all entities on levels 1 through 10
;; (select (has-attrib "level" (number-in-range 1 10)))

;;----------------------------------------------------------------------
;; You can have attributes automatically assigned to entities when they
;; are created.  For example, the following code can be used to
;;  automatically add a level attribute to new entities.

;(define Default-Level 1)

;(set! entity-creation-hook
;      (let ((old-ech entity-creation-hook))
;        (lambda (ent)
;          (old-ech ent)
;          (attrib:add ent "level" Default-Level)
;          )))
